#!/bin/perl
##############################################################################################
# Copyright (c) Microsoft
#
# All rights reserved
#
# Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file
# except in compliance with the License. You may obtain a copy of the License at
# http://www.apache.org/licenses/LICENSE-2.0
#
# THIS CODE IS PROVIDED *AS IS* BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, EITHER
# EXPRESS OR IMPLIED, INCLUDING WITHOUT LIMITATION ANY IMPLIED WARRANTIES OR CONDITIONS OF
# TITLE, FITNESS FOR A PARTICULAR PURPOSE, MERCHANTABLITY OR NON-INFRINGEMENT.
#
# See the Apache Version 2.0 License for specific language governing permissions and
# limitations under the License.
##############################################################################################

#usage:
# perl run_test.pl <Test root dir> [<test list>]
# test root dir: base directory to look for tests from.
# test list: if provided, a list of test.cpp files to test, one per line.
#            Otherwise all are run. If provided the script will exit 1 if any
#            tests fail.

use Config;
use Cwd;
use Cwd 'abs_path';
use File::Basename;
use File::Find;
use Getopt::Long;
use Safe;
use threads;
use threads::shared;
use strict;

my $max_num_threads = @AMP_CONFORMANCE_NUM_THREADS@;
my $use_threads = $Config{useithreads} and $max_num_threads > 1;
my $console_lock : shared = 0;
my $device_lock : shared = 0;

my $skip_build_only = 0;
GetOptions ("skip-build-only" => \$skip_build_only)
      or die("Error in command line arguments\n");

my $cflag_define = '"-D%s=%s"'; # to be used as sprintf($cflag_define, "NAME", "VALUE");
my $run_log :shared = abs_path('run.log');
mkdir("conformance-temp");
my $tmpdir = abs_path('./conformance-temp');

my $tests_root = @ARGV[0];
if (!$tests_root) {
    print "ERROR: Test root dir not provided\n";
    exit(1);
}
$tests_root = abs_path($tests_root);
chdir($tests_root);

my $CLANG_AMP_HOME='@PROJECT_SOURCE_DIR@';
my $CLANG_AMP_BUILD_DIR='@PROJECT_BINARY_DIR@';

my $AMPTESTLIB='@AMPTESTLIB@';
my $AMPTESTINC='@AMPTESTINC@';
my $RUNTESTSDIR='@RUNTESTSDIR@';


my $CLANG_AMP="$CLANG_AMP_BUILD_DIR/compiler/bin/clang++";
my $CLAMP_CONFIG=`find $CLANG_AMP_BUILD_DIR/bin -name clamp-config -print`;
$CLAMP_CONFIG =~ s/^\s+//;
$CLAMP_CONFIG =~ s/\s+$//;
my $CLAMP_CXXFLAGS=`$CLAMP_CONFIG --build --cxxflags`;
$CLAMP_CXXFLAGS =~ s/^\s+//;
$CLAMP_CXXFLAGS =~ s/\s+$//;
my $CLAMP_LDFLAGS=`$CLAMP_CONFIG --build --ldflags`;
$CLAMP_LDFLAGS =~ s/^\s+//;
$CLAMP_LDFLAGS =~ s/\s+$//;
my $SHARED_CXXFLAGS="$CLAMP_CXXFLAGS -I$AMPTESTINC -I/usr/include -I$CLANG_AMP_BUILD_DIR/compiler/lib/clang/3.5.0/include/";

### Prepare environment
if(-e $run_log)
{
    system("rm $run_log");
}

### Find tests
my @tests;
my $has_test_list=0;

sub match_tests
{
    if(lc($_) eq 'test.cpp')
    {
        push @tests, cwd().'/'.$_;
    }
}

if (@ARGV[1]) {
    open(TESTLIST, @ARGV[1]) or &exit_message(1, "Cannot open test list: @ARGV[1]");
    while(<TESTLIST>) {
        chomp;
        if (-e $tests_root."/".$_) {
            push @tests, abs_path($tests_root."/".$_);
        }
    }
    close(TESTLIST);
    $has_test_list=1;
} else {
    find(\&match_tests, cwd());
}

### Execute tests
use constant PASS => 0;
use constant SKIP => 1;
use constant FAIL => 2;
my $num_passed : shared = 0;
my $num_skipped : shared = 0;
my $num_failed : shared = 0;
my $num_others: shared = 0;

chdir($tmpdir);

my $active_threads :shared = 0;
my $test_id :shared = 0;

foreach my $test (@tests)
{
    if (not $use_threads) {
        run_test($test);
        next;
    }

    { lock($active_threads); cond_wait($active_threads) until $active_threads < $max_num_threads; }
    $active_threads++;
    my $thr = threads->create(\&run_test, $test);
    ## DO NOT join or detach the thread. This line is intentionally left blank
}

sub run_test {
    my ($test) = @_;

    if (not $test)
    {
       log_message("Test: N/A");
       goto continue_ite;
    }

    log_message("Test: $test");
    my $test_exec = "$tmpdir/test.out";
    if ($use_threads) {
        {lock($test_id); $test_exec.=$test_id; $test_id++;}
    }

    # Read test configuration
    undef %Test::config;
	
	my $conf_file = try_find_file_by_extension(abs_path(dirname(($test))), $tests_root, "conf");
	
     if(-e $conf_file)
    {
        my $safe = new Safe('Test');
        $safe->rdo($conf_file) or &exit_message(1, "Cannot open $conf_file");
    }

    if(not defined $Test::config{'definitions'})
    {
        $Test::config{'definitions'} = [{}];
    }

    # Find "expects error" directives in cpp
    open(TEST_CPP, $test) or goto continue_ite;
    $Test::config{'expected_success'} = (grep m@//#\s*Expects\s*(\d*)\s*:\s*(warning|error)@i, <TEST_CPP>) == 0;
    close(TEST_CPP);

    log_message('Compile only: '.bool_str($Test::config{'compile_only'})."\n"
        .'Expected success: '.bool_str($Test::config{'expected_success'}));

    # check to see if test has its own main
    # This solution taken from https://github.com/pathscale/amp-testsuite/commit/1f9f186d27446e52bd50dbcf429844f3fa308303
    my $include_main='';
    if (! system ("cat $test | grep ' main *(' > /dev/null")) {
        $include_main="-include $RUNTESTSDIR/test_main.h";
    }

    # For each set of definitions
    foreach my $def_set (@{$Test::config{'definitions'}})
    {
        # If we are using threads we want to print the test name and its
        # result together otherwise the output will be jumbled.  This has
        # the disadvantage of not being able to see the test name when it
        # hangs, but there are other ways to get this information (e.g. with
        # ps).
        if (not $use_threads) {
            print "$test : ";
        }
        my $result;

        # Build and execute test
        my $cflags_defs = '';
        while(my ($k, $v) = each(%{$def_set}))
        {
            $cflags_defs = $cflags_defs.sprintf($cflag_define.' ', $k, $v);
        }
        my $command;
        if ($Test::config{'compile_only'}) {
            $command = "\\
                $CLANG_AMP -fcxx-exceptions -fsyntax-only -D__CPU__=1 $SHARED_CXXFLAGS $include_main $test $cflags_defs 2>&1";
       } elsif ($ENV{TEST_CPU} eq "ON") {
           $command = "\\
           $CLANG_AMP -std=c++amp -cpu $SHARED_CXXFLAGS $include_main $test $AMPTESTLIB $cflags_defs $CLAMP_LDFLAGS -o $test_exec -g 2>&1";
        } else {
            $command = "\\
                $CLANG_AMP $SHARED_CXXFLAGS $include_main $test $AMPTESTLIB $cflags_defs $CLAMP_LDFLAGS -o $test_exec -g 2>&1";
        }

        log_message("Command: $command\n"
            ."Build output:\n"
            ."<<<");

	if ($skip_build_only && ($Test::config{'compile_only'} || not $Test::config{'expected_success'})) {
		$result = SKIP;
		goto test_done;
	}

        my $cmd_output = `$command`;
        my $build_exit_code = $?;
        my $build_exit_signal = $build_exit_code & 127;
        log_message($cmd_output);
        log_message(">>>\n"
            ."Build exit code: $build_exit_code");
        $build_exit_code >>= 8;

        my $exec_exit_code = 0;
        my $exec_exit_signal = 0;
        my $timeout=0;
        if((not $Test::config{'compile_only'}) && $build_exit_code == 0 && $Test::config{'expected_success'})
        {
            log_message("Execution output:\n"
                .'<<<');
            eval {
                # Disable the alarm when using threads.  We don't control the
                # order that threads are given access to the GPU, so it's
                # possible to have on thread that is starved for the entire
                # conformance run.  Therefore, we cannot safely use this alarm
                # without accidently killing vaild tests.
                if (not $use_threads) {
                    local $SIG{ALRM} = sub { die "alarm\n" }; # NB: \n required
                    alarm 60;
                }
                {
                    # Tests which allocate large buffers or use all compute
                    # units for long periods of time may cause sporadic failures,
                    # so use a device lock to ensure only one test is running at
                    # the same time.
                    lock($device_lock);
                    $cmd_output = `$test_exec 2>&1`;
                }
                $exec_exit_code = $?;
                $exec_exit_signal = $exec_exit_code & 127;
                log_message($cmd_output);
                alarm 0;
            };
            if ($@) {
                die unless $@ eq "alarm\n";   # propagate unexpected errors
                $timeout=1;
            }
            log_message(">>>\n"
                ."Execution exit code: $exec_exit_code");
            $exec_exit_code >>= 8;
        }

        # Interpret result
        if($timeout == 1) {
            $result = FAIL;
        }
        elsif ($build_exit_signal || $exec_exit_signal)
        {
            $result = FAIL;
        }
        elsif(not $Test::config{'expected_success'}) # Negative test
        {
            if($build_exit_code != 0)
            {
                $result = PASS;
            }
            else
            {
                $result = FAIL;
            }
        }
        elsif($Test::config{'compile_only'}) # Compile only test
        {
            if($build_exit_code == 0)
            {
                $result = PASS;
            }
            else
            {
                $result = FAIL;
            }
        }
        else # Executable test
        {
            if($build_exit_code != 0)
            {
                $result = FAIL;
            }
            elsif($exec_exit_code == 0)
            {
                $result = PASS;
            }
            elsif($exec_exit_code == 2)
            {
                $result = SKIP;
            }
            else
            {
                $result = FAIL;
            }
        }

test_done:

    {
        lock($console_lock);
        if ($use_threads) {
            print "$test : ";
        }

        if($result == PASS)
        {
            $num_passed++;
            print "passed\n";
            log_message('Result: passed');
        }
        elsif($result == FAIL)
        {
            $num_failed++;
            if ($timeout == 1) {
                print "failed, timeout\n";
                log_message('Result: failed, timeout');
            } else {
                print "failed\n";
                log_message('Result: failed');
            }
        }
        elsif($result == SKIP)
        {
            $num_skipped++;
            print "skipped\n";
            log_message('Result: skipped');
        }
        else
        {
            flush_log();
            exit_message(1, "Unexpected result!");
        }
    }

    }
    goto next_ite;

continue_ite:
    $num_others++;
    print "$test: invalid\n";
    log_message('Result: invalid or cannot open');

next_ite:
    #chdir($tests_root);
    log_message("=====================================================");
    flush_log();
    {
        lock ($active_threads);
        $active_threads--;
        cond_signal($active_threads);
    }

   ## Detach itself
   threads->detach();
}

### Wait for all self-detached threads to complete.
while (threads->list()) {
  # yield CPU cycle
  sleep 1;

  # For debug purpose
  # my $n = threads->list();
  # print "running threads num = $n\n"

}

### Print summary
my $num_total = $num_passed + $num_skipped + $num_failed + $num_others;
print "==========================\n";
if($num_total != 0)
{
    printf(" Passed:  %d (%.3f%%)\n", $num_passed,  $num_passed / $num_total * 100);
    printf(" Skipped: %d (%.3f%%)\n", $num_skipped, $num_skipped / $num_total * 100);
    printf(" Failed:  %d (%.3f%%)\n", $num_failed,  $num_failed / $num_total * 100);
    printf(" Others(Invalid/Cannot Open): %d (%.3f%%)\n", $num_others, $num_others / $num_total * 100);
}
print " Total:  $num_total\n";
print "==========================\n";

if ($has_test_list && $num_failed>0) {
    exit_message(1, "Conformance tests failed\n");
}

### Subroutines
# Use: exit_message(code, msg)
sub exit_message
{
    if(@_ != 2) { die('exit_message expects 2 arguments'); }
    print("\n".($_[0] == 0 ? 'SUCCESS' : 'FAILURE').": ".$_[1]);
    exit($_[0]);
}

my $log_buffer='';
# Use: log_message(msg, ...)
sub log_message
{
    $log_buffer.="@_\n";
}

sub flush_log
{
    {
        lock($run_log);
        open(FH, ">>", $run_log) or &exit_message(1, "Cannot open $run_log");
        print FH $log_buffer;
        close(FH);
    }
    $log_buffer='';
}

# Use: bool_str(val)
# Returns: string 'true'/'false'
sub bool_str
{
    return $_[0] ? 'true' : 'false';
}

## Use: get_files_by_extension($start_dir, $ext);
## Returns: List of files with given extension
sub get_files_by_extension($$)
{
    my $dir = $_[0];
    my $ext = $_[1];

	my @files = `ls $dir`;
    my @ext_files;
	
    for my $file (@files)
    {
		if($file =~ /\.$ext$/i)
		{
			chomp($file);
			push(@ext_files, $file);
		}
    }

    return @ext_files;    	
}

## Use: try_find_file_by_extension($start_dir, $end_dir, $ext);
## Returns: Relative path to file found. Empty if no file exists. -1 if error is encountered.
sub try_find_file_by_extension($$$)
{
	my $start_dir = $_[0];
	my $end_dir = $_[1];
	my $ext = $_[2];
	
	if(index($start_dir, $end_dir) == -1)
	{
		print "ERROR: $start_dir is not a subdirectory of $end_dir.";
		return -1;
	}
	
	my @files;

	do
	{	
		@files = get_files_by_extension($start_dir, $ext);
		
		if(@files > 1)
		{
			print "Error: More than one (*.$ext) files present in directory $start_dir\n";
			return -1;
		}
		
		if(@files != 0)
		{
			my $file = $files[0];
			
			if(-e "$start_dir/$file")
			{
				return "$start_dir/$file";
			}
		}
		
		# Move to parent directory to continue search
		$start_dir = dirname($start_dir);
	}
	while(index($start_dir, $end_dir) != -1);
	
	return "";
}
